Celestin Apprentice 5/Apprentice-Release5.iso/Utilities/Communications/Pancake Dev Package 1.0/Editor/Editor.p

Text File | 1995-09-06 | 11.0 KB | 469 lines | [TEXT/PJMM]

unit Editor;
interface
    uses
        PancakeCommon;

    procedure MAIN (params: editParamsPtr);

implementation

    procedure MAIN (params: editParamsPtr);
        var
            curTextHand: ptr2hand;
            keyBuf: ptr2str;

        procedure Write (str: string);
        begin
            WriteProc(str, params^.procs[1]);
        end;
        procedure Writeln (str: string);
        begin
            WritelnProc(str, params^.procs[2]);
        end;
        procedure WriteHand (hand: Handle);
        begin
            WriteHandProc(hand, params^.procs[3]);
        end;
        procedure ListResFile (name: string);
        begin
            ListResFileProc(name, params^.procs[4]);
        end;
        procedure SetNodeAction (action: NodeActionType);
        begin
            SetNodeActionProc(action, params^.procs[5]);
        end;
        procedure RestoreNodeAction;
        begin
            RestoreNodeActionProc(params^.procs[6]);
        end;
        procedure JumpTo (x, y: integer);
        begin
            JumpToProc(x, y, params^.procs[7]);
        end;
        procedure Out (str: string);
        begin
            OutProc(str, params^.procs[8]);
        end;
        procedure OutPtr (buf: ptr; size: longint);
        begin
            OutPtrProc(buf, size, params^.procs[9]);
        end;
        procedure Report (where: integer; str: string);
        begin
            ReportProc(where, str, params^.procs[10]);
        end;
        function GetVarPtr (which: integer): ptr;
        begin
            GetVarPtr := GetVarPtrProc(which, params^.procs[11]);
        end;
        procedure ListHand (hand: handle);
        begin
            ListHandProc(hand, params^.procs[12]);
        end;
        function ListTextFile (pathname, filename: string): OSErr;
        begin
            ListTextFile := ListTextFileProc(pathname, filename, params^.procs[13]);
        end;
        procedure LettersPrompt (prompt, possible: string; len: byte);
        begin
            LettersPromptProc(prompt, possible, len, params^.procs[14]);
        end;
        procedure PasswordPrompt (prompt, possible: string; len: byte);
        begin
            PasswordPromptProc(prompt, possible, len, params^.procs[15]);
        end;
        procedure NumbersPrompt (prompt, possible: string; max: longint);
        begin
            NumbersPromptProc(prompt, possible, max, params^.procs[16]);
        end;
        procedure AutoPrompt (prompt, possible: string);
        begin
            AutoPromptProc(prompt, possible, params^.procs[17]);
        end;
        procedure YesNoPrompt (prompt: string; yesDefault: boolean);
        begin
            YesNoPromptProc(prompt, yesDefault, params^.procs[18]);
        end;
        procedure DatePrompt (prompt: string);
        begin
            DatePromptProc(prompt, params^.procs[19]);
        end;
        procedure PhonePrompt (prompt: string);
        begin
            PhonePromptProc(prompt, params^.procs[20]);
        end;
        procedure ClrScr;
        begin
            ClrScrProc(params^.procs[21]);
        end;
        function ReplacePercents (str: string; replaceProc: procPtr; user: userRecPtr): string;
        begin
            ReplacePercents := ReplacePercentsProc(str, replaceProc, user, params^.procs[22]);
        end;
        function HasAccess (acs: string): boolean;
        begin
            HasAccess := HasAccessProc(acs, params^.procs[23]);
        end;
        procedure SendFile (protocol: char; path, filename: string);
        begin
            SendFileProc(protocol, path, filename, params^.procs[24]);
        end;
        procedure ReceiveFile (protocol: char; path, filename: string; theRout: ProcPtr);
        begin
            ReceiveFileProc(protocol, path, filename, params^.procs[25]);
        end;

        function s2i (t1: str255): longint;
            var
                t2: longint;
        begin
            StringToNum(t1, t2);
            s2i := t2
        end;
        function i2s (t1: longint): string;
            var
                t2: str255;
        begin
            NumToString(t1, t2);
            i2s := t2
        end;

        function GetStr (which: integer): string;
            var
                str: str255;
        begin
            UseResFile(params^.externRefnum);
            GetIndString(str, 128, which);
            UseResFile(params^.appRefnum);
            GetStr := str;
        end;

        procedure InitStorage;
            var
                err: OSErr;
        begin
            curTextHand := ptr2hand(GetVarPtr(vCurTextHand));
            with params^, privates^^ do
                if curTextHand^ = nil then
                    begin
                        EditText := EditHand(NewHandle(1024));
                        EditSize := 1024;
                        EditPos := 0;
                    end
                else
                    begin
                        EditText := EditHand(curTextHand^);
                        err := HandToHand(handle(EditText));
                        if err <> noErr then
                            Writeln('Memory Full!!! Fatal Error');
                        EditPos := GetHandleSize(handle(EditText));
                        EditSize := EditPos + 1024;
                        SetHandleSize(handle(EditText), EditSize);
                        EditSize := GetHandleSize(handle(EditText));
                        ListHand(curTextHand^);
                    end;
        end;

        procedure SaveText;
            var
                err: OSErr;
        begin
            with params^ do
                begin
                    SetHandleSize(handle(privates^^.EditText), privates^^.EditPos - length(privates^^.curLine));
                    curTextHand^ := handle(privates^^.EditText);
                    HLockHi(curTextHand^);
                    DisposeHandle(handle(privates));
                    privates := nil;
                    RestoreNodeAction;
                    Exit(Main);
                end;
        end;

        procedure Abort;
            var
                err: OSErr;
        begin
            with params^ do
                begin
                    DisposeHandle(Handle(Privates^^.EditText));
                    curTextHand^ := nil;
                    DisposeHandle(handle(privates));
                    privates := nil;
                    RestoreNodeAction;
                    Exit(Main);
                end;
        end;

        function UpperCase (str: string): string;
            var
                i, j: byte;
        begin
            for i := 1 to length(str) do
                begin
                    j := ord(str[i]);
                    if (j > 96) and (j < 123) then
                        str[i] := chr(j - 32);
                end;
            UpperCase := str;
        end;

        procedure ProccessLine;
        begin
            with params^.privates^^ do
                begin
                    curLine := UpperCase(curLine);
                    if (curLine = '/S') or (curLine = '/ES') or (curLine = '/ESN') or (curLine = '/ESP') then
                        SaveText
                    else if curLine = '/ABT' then
                        Abort
                    else if (curLine = '/?') or (curLine = '/H') or (curLine = '/HELP') then
                        begin
                            EditPos := EditPos - length(curLine);
                            ListResFile('Editor Help');
                        end;
                    curLine := '';
                end
        end;

        function FillChar (chh: char; len: byte): string;
            var
                b: byte;
                tstr: string;
        begin
            tstr := '';
            for b := 1 to len do
                tstr[b] := chh;
            tstr[0] := chr(len);
            FillChar := tstr;
        end;

        procedure WordWrap;
            var
                num: byte;
        begin
            with params^.privates^^ do
                begin
                    num := EditPos + 1;
                    repeat
                        num := num - 1;
                    until (num = 1) | (EditText^^[num] = ' ') | (EditText^^[num] = Return);
                    if (EditText^^[num] = ' ') then
                        begin
                            CurLine := '';
                            BlockMove(@EditText^^[num + 1], @CurLine[1], EditPos - num);
                            CurLine[0] := chr(EditPos - num);
                            EditText^^[num] := Return;
                            Write(concat(FillChar(Backspace, EditPos - num), FillChar(' ', EditPos - num), FillChar(Backspace, EditPos - num)));
                            Write(return);
                            Write(CurLine);
                        end
                    else
                        begin
                            CurLine := '';
                            EditPos := EditPos + 1;
                            EditText^^[EditPos] := Return;
                            Write(return);
                        end;
                end;
        end;

        procedure Edit;
        begin
            with params^.privates^^ do
                begin
                    SetHandleSize(handle(editText), editPos);
                    curTextHand^ := handle(editText);
                    curLine := '';
                    stage := Editing;
                    ClrScr;
                    Write(GetStr(1));
                    InitStorage;
                end;
        end;

        procedure IdleExt;
            var
                curAnswer: ptr2str;
        begin
            curTextHand := ptr2hand(GetVarPtr(vCurTextHand));
            curAnswer := ptr2str(GetVarPtr(vCurAnswer));
            with params^.privates^^ do
                begin
                    if prompt = SureAbort then
                        begin
                            if curAnswer^ = 'Yes' then
                                Abort
                            else
                                Edit;
                        end
                    else
                        case curAnswer^[1] of
                            'A':
                                begin
                                    Writeln('bort');
                                    Abort;
                                end;
                            'S':
                                begin
                                    Writeln('ave');
                                    SaveText;
                                end;
                            Return:
                                begin
                                    Writeln('Save');
                                    SaveText;
                                end;
                            'E':
                                begin
                                    Writeln('dit');
                                    Edit
                                end;
                        end;
                end;
        end;

        procedure ProcessKey;
            var
                ch: char;
                i, j: integer;
        begin
            curTextHand := ptr2hand(GetVarPtr(vCurTextHand));
            keyBuf := ptr2str(GetVarPtr(vKeyBuf));
            with params^.privates^^ do
                while (keyBuf^ <> '') do
                    begin
                        ch := keyBuf^[1];
            {$R-}
                        keyBuf^[0] := chr(ord(keyBuf^[0]) - 1);
                        BlockMove(ptr(ord4(keyBuf) + 2), ptr(ord4(keyBuf) + 1), ord(keyBuf^[0]));
            {$R+}
                        if ch = Destructive then
                            ch := Backspace;
                        if (ch = chr(24)) then
                            begin
                                if curLine <> '' then
                                    begin
                                        EditPos := EditPos + 1;
                                        EditText^^[EditPos] := Return;
                                        Write(Return);
                                    end;
                                curLine := '';
                                ptr2bool(GetVarPtr(vNoReturn))^ := true;
                                AutoPrompt(GetStr(2), concat('SAE', Return));
                                prompt := SaveEditEtc;
                                stage := EndPrompting;
                            end
                        else if (ch = chr(3)) then
                            begin
                                if curLine <> '' then
                                    Write(Return);
                                YesNoPrompt(GetStr(3), true);
                                prompt := SureAbort;
                                stage := EndPrompting;
                            end
                        else if (ch = Escape) then
                        else if (ch = Backspace) then
                            begin
                                if EditPos > 0 then
                                    begin
                                        if EditText^^[EditPos] = Return then
                                            begin
                                                EditPos := EditPos - 1;
                                                j := 1;
                                                for i := EditPos downto 1 do
                                                    if EditText^^[i] = Return then
                                                        begin
                                                            j := i + 1;
                                                            leave;
                                                        end;
                                                BlockMove(@EditText^^[j], @curLine[1], EditPos - j + 1);
                    {$R-}
                                                curLine[0] := chr(EditPos - j + 1);
                    {$R+}
                                                Out(concat(Escape, '[A'));
                                                if curLine <> '' then
                                                    Out(concat(Escape, '[', i2s(length(curLine)), 'C'));
                                            end
                                        else
                                            begin
                                                EditPos := EditPos - 1;
                                                Write(concat(Backspace, ' ', Backspace));
                                                Delete(curLine, length(curLine), 1);
                                            end;
                                    end;
                            end
                        else
                            begin
                                if (ch = Return) then
                                    ProccessLine
                                else
                                    begin
                                        if ord(curLine[0]) > 77 then
                                            WordWrap;
                                        curLine := concat(curLine, ch);
                                    end;
                                write(ch);
                                EditPos := EditPos + 1;
                                EditText^^[EditPos] := ch;
                                if EditPos = EditSize then
                                    begin
                                        EditSize := EditSize * 2;
                                        SetHandleSize(handle(EditText), EditSize);
                                        if MemError = memFullErr then
                                            begin
                                                Writeln('Memory Full!!! Fatal Error');
                                            end;
                                        EditSize := GetHandleSize(handle(EditText));
                                    end;
                            end;
                    end;
        end;

        procedure InitEditor;
        begin
            with params^ do
                begin
                    privates := privatesHand(NewHandle(SizeOf(privatesRec)));
                    HLockHi(handle(privates));
                    with privates^^ do
                        begin
                            Write(GetStr(1));
                            InitStorage;
                            stage := Editing;
                            curLine := '';
                        end;
                end;
        end;

        procedure DisposeEditor;
        begin
            curTextHand := ptr2hand(GetVarPtr(vCurTextHand));
            with params^ do
                if privates <> nil then
                    begin
                        DisposeHandle(Handle(Privates^^.EditText));
                        curTextHand^ := nil;
                        DisposeHandle(handle(privates));
                        privates := nil;
                        RestoreNodeAction;
                    end;
        end;

    begin
        if (params^.message <> DisposeGlobal) and (params^.privates = nil) then
            InitEditor;
        case params^.message of
            Idle:
                if params^.privates^^.stage = EndPrompting then
                    IdleExt;
            KeyPressed:
                if params^.privates^^.stage = Editing then
                    ProcessKey;
            DisposeExt:
                DisposeEditor;
            DisposeGlobal:
                params^.globals := nil;
        end;
    end;
end.